home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lcu.zip / ERRPROCS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  2KB  |  84 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean complete evaluation off}
  3. {$S-}    {Stack checking off}
  4. {$N-}    {No numeric coprocessor}
  5. {$I-}    {IO Checking Off}
  6. {$D-}
  7. {$T-}
  8.  
  9. Unit ErrProcs;
  10. Interface
  11. {JW Sparks, last modified 06/30/88}
  12.  
  13. uses Crt, Colors;
  14.  
  15. Type
  16.    ErrorByteSet         = Set of Byte;
  17. Var
  18.    IOErr            : Boolean;
  19.    ErrorMessage     : String;
  20.    SelectedErrCodes : ErrorByteSet;
  21.    ErrorNumber      : Integer;
  22.  
  23. Procedure DisplayErrorMessages(ErrNum: Integer; SelectedErrCodes : ErrorByteSet);
  24.  
  25. Procedure IOCheck(var ErrorNumber : Integer; SelectedErrCodes : ErrorByteSet);
  26.  
  27. {-----}
  28.  
  29. Implementation
  30.  
  31. {***}
  32.  
  33. Procedure DisplayErrorMessages(ErrNum: Integer; SelectedErrCodes : ErrorByteSet);
  34. begin
  35. if not (ErrNum in SelectedErrCodes) then exit;
  36.  
  37. case ErrNum of
  38.        {Dos Errors}
  39.        0 : ErrorMessage := 'Input/Output Operation performed normally';
  40.        2 : ErrorMessage := 'File not Found';
  41.        3 : ErrorMessage := 'Path not Found';
  42.        4 : ErrorMessage := 'Too Many Open Files';
  43.        5 : ErrorMessage := 'Access Denied';
  44.        6 : ErrorMessage := 'Invalid Handle';
  45.        8 : ErrorMessage := 'Not Enough Memory';
  46.       10 : ErrorMessage := 'Invalid Environment';
  47.       11 : ErrorMessage := 'Invalid Format';
  48.       15 : ErrorMessage := 'Invalid Drive Number';
  49.       18 : ErrorMessage := 'No More Files';
  50.  
  51.      {I/O Errors}
  52.      100 : ErrorMessage := 'Disk Read Error';
  53.      101 : ErrorMessage := 'Disk Write Error';
  54.      150 : ErrorMessage := 'Disk is Write Protected';
  55.      152 : ErrorMessage := 'Drive is Not Ready';
  56.  
  57.      {User defined Errors}
  58.      200 : ErrorMessage := 'Not Enough Space on Destination Drive';
  59.      210 : ErrorMessage := 'File Copy Aborted';
  60.      211 : ErrorMessage := 'File Compare Aborted';
  61.          else begin
  62.                  Str(ErrNum:3, ErrorMessage);
  63.                  ErrorMessage := 'Unknown I/O error:  ' + ErrorMessage;
  64.               end;
  65. end; {Case}
  66. TextColor(Warning);
  67. WriteLn(ErrorMessage);
  68. TextColor(Foreground);
  69. end; {DisplayErrorMessages}
  70.  
  71. {***}
  72.  
  73. procedure IOCheck(var ErrorNumber : Integer; SelectedErrCodes : ErrorByteSet);
  74. {Stores IOresult in ErrorNumber and
  75.  Sets IOErr to TRUE if ErrorNumber in SelectedErrCodes}
  76. begin
  77. ErrorNumber := IOresult;
  78. IOErr := (ErrorNumber in SelectedErrCodes);
  79. DisplayErrorMessages(ErrorNumber, SelectedErrCodes);
  80. end; {IOCheck}
  81.  
  82. {***}
  83. end.
  84.